home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1997 July: Mac OS SDK / Dev.CD Jul 97 SDK2.toast / Development Kits (Disc 2) / ScriptX / Code Samples / untested / tcpip / browser / webb.sx < prev   
Encoding:
Text File  |  1996-05-21  |  5.7 KB  |  235 lines  |  [TEXT/ttxt]
  1. --<<<
  2.  
  3. in module WebBrowser
  4.  
  5. class WebBrowser ()
  6. instance variables
  7.     topWin
  8.     scroller
  9.     group
  10.     currentURL
  11.     displayer
  12.     forwardList
  13.     backwardList
  14.     reloadButton
  15.     backButton
  16.     forwardButton
  17.     status
  18.     applets : (new Array)
  19.     urlField
  20.     openFileButton
  21.     gotoButton
  22. end
  23.  
  24.  
  25. method  makewebbutton self {object Webbrowser} label x y win fun  -> (
  26.     local pb := new TextButton text: label
  27.     pb.x := x
  28.     pb.y := y
  29.     append win pb
  30.     pb.activateAction := (data button -> fun self)
  31.     pb
  32. )
  33.  
  34. method gotoURLCallback self {object Webbrowser} ->
  35.     followlink self (new url string: self.urlfield.text)
  36.  
  37.  
  38. method openFile self {object Webbrowser} -> (
  39.     local o := new openpanel
  40.     openfilepanel o
  41.     if o.validreply do (
  42.         local u := "file://" as string
  43.         for x in o.filename do (
  44.             addmany u "/"
  45.             addmany u x
  46.         )
  47.         followlink self (new url string: u)
  48.     )
  49. )
  50.  
  51. method init self {object WebBrowser} #rest args #key url: -> (
  52.     apply nextMethod self args
  53. --    self.topWin := new window boundary: (new rect x1: 50 y1: 50 x2: 600 y2: 700) name: "HotSX"
  54.     self.topWin := new window boundary: (new rect x1: 50 y1: 50 x2: 600 y2: 600) name: "HotSX"
  55.     local bc := new actuatorcontroller space: self.topWin
  56.     bc.wholespace := true
  57.     self.backButton := makeWebButton self "Back" 10 10 self.topWin goBack
  58.     self.reloadButton := makeWebButton self "reload" 100 10 self.topWin reload
  59.     self.forwardButton := makeWebButton self "forward" 200 10 self.topWin goForward
  60.     self.openFileButton := makeWebButton self "open file" 300 10 self.topWin openFile
  61.     
  62.     local headerHeight := 50
  63.     local footerHeight := 20
  64.     local spacing := 20
  65.     
  66.     local gotoY := spacing + self.openFileButton.height
  67.     
  68.     self.gotoButton := makeWebButton self "Goto:" 10 gotoY self.topWin gotoURLCallback
  69.     
  70.     headerHeight := headerHeight + self.gotoButton.height + spacing
  71.     
  72.     self.urlField := new SmallTextEdit
  73.     self.urlField.width := 400
  74.     
  75.     self.urlField.x := 10 + self.gotoButton.width + spacing
  76.     self.urlField.y := gotoY
  77.     
  78.     append self.topWin self.urlField
  79.     
  80.     local scrollerHeight := ( self.topwin.height - headerHeight - footerHeight)
  81.     self.scroller := new ScrollingPresenter \
  82.         vertScrollbar: (new SimpleScrollBar \
  83.                     height: scrollerHeight) \
  84.         fill:WhiteBrush \
  85.         stationary:true \
  86.         stroke: blackbrush \
  87.         boundary: (new rect x2: self.topwin.width \
  88.                         y2: scrollerHeight)
  89.     self.scroller.y := headerHeight
  90.     append self.topwin self.scroller
  91.     self.group := new groupPresenter
  92.     self.scroller.targetPresenter := self.group
  93.  
  94.     show self.topWin
  95.     self.forwardList := new LinkedList
  96.     self.backwardList := new LinkedList
  97.  
  98.     self.status := new textPresenter target: "hello there" \
  99.                     boundary: (new rect x2: self.topwin.width \
  100.                                     y2: footerHeight)
  101.     self.status.y := self.topwin.height - footerHeight
  102.     append self.topwin self.status
  103.     if url != unsupplied then
  104.         gotoURL self url
  105.     else
  106.         updateButtons self
  107. )
  108.  
  109. method updateButtons self {object WebBrowser} -> (
  110.     self.reloadButton.enabled := self.currentURL != undefined
  111.     self.backButton.enabled := not (isempty self.backwardList)
  112.     self.forwardButton.enabled := not (isempty self.forwardList)
  113.     if self.currentURL != undefined do 
  114.         self.urlField.text := self.currentURL.string
  115. )
  116.  
  117. method setStatus self {object WebBrowser} status -> 
  118.     self.status.target := status
  119.     
  120. method gotoURL self {object WebBrowser} aurl -> (
  121.     setstatus self "Downloading..."
  122.     -- We can get some kind of error at this point
  123.  
  124.     if not (isakindof aurl url) do
  125.         aurl := new url string: aurl
  126.  
  127.     local s := geturl WebAccessManager aurl
  128.  
  129.     -- Perhaps a transition would be nice!
  130.  
  131.     if (present WebPresentationManager s \
  132.         callback: (ignore url -> followLink self url) \
  133.         boundary: (new rect x2: ( self.topwin.width - self.scroller.vertScrollbar.width) \
  134.                     y2: self.topwin.height) \
  135.         url: aurl \
  136.         parent:     self.group \
  137.         browser: self) 
  138.     do (
  139.     
  140.         -- End of possible errors
  141.     
  142.         layout self.scroller
  143.         self.currentURL := aurl
  144.         updateButtons self
  145.         setStatus self ""
  146.         return true
  147.     )
  148.     setStatus self ""
  149.     updateButtons self
  150.     return false
  151. )
  152.  
  153. method followLink self {object WebBrowser} url -> \
  154.     doSomething self \
  155.         (-> 
  156.            local old := self.currentURL
  157.            -- Used & otherwise the 'event dispatch queue' thread messed up
  158.            if gotoURL self url do (
  159.                if old != undefined do (
  160.                    prepend self.backwardList old
  161.                    emptyOut self.forwardList
  162.                )
  163.           )
  164.       )
  165.  
  166.  
  167. method goBack self {object WebBrowser} -> \
  168.     dosomething self \
  169.         (-> 
  170.             local n := pop self.BackwardList
  171.             prepend self.forwardList self.currentURL
  172.             gotoURL self n
  173.         )
  174.  
  175. method goForward self {object WebBrowser} -> \
  176.     dosomething self \
  177.     ( ->
  178.         local n := pop self.forwardList
  179.         prepend self.backwardList self.currentURL
  180.         gotoURL self n
  181.     )
  182.  
  183. method reload self {object WebBrowser} -> \
  184.     dosomething self (-> gotoURL self self.currentURL)
  185.  
  186. -- We need a way of managing this
  187. -- We should just keep track of this thread and kill it
  188.  
  189. method doSomething self {object WebBrowser} something -> \
  190.     (
  191.         guard
  192.             something()
  193.         catching
  194.             Exception : (
  195.                 local s := new string
  196.                 format s throwtag throwarg
  197.                 setStatus self s
  198.                 caught undefined
  199.             )
  200.         end
  201.         updateButtons self
  202.     ) &
  203.  
  204. method addApplet self {object WebBrowser} applet -> (
  205.     append self.applets applet
  206. )
  207.  
  208. method clearCurrent self {object WebBrowser} -> (
  209.   -- Perhaps a transition would be nice!
  210.   emptyOut self.group
  211.   map self.applets (applet arg -> terminate applet) undefined
  212.   emptyOut self.applets
  213. )
  214.  
  215. function presentHTML stuff #rest args #key browser: -> (
  216.     clearCurrent browser
  217.     local displayer := apply new htmlDisplayer args
  218.     stuff[2] | displayer.stream
  219.     plug stuff[2]
  220.     plug displayer
  221.     return true
  222. )
  223.  
  224. registerPresentMethod WebPresentationManager "text/html" presentHTML
  225.  
  226. global theWebBrowser := undefined
  227.  
  228. function startWebBrowser tc -> (
  229.     if not (isdefined tcpstream) do process (new loader) "loadable/web"
  230.      foreach tc load undefined
  231.      theWebBrowser := new webbrowser
  232. )
  233.  
  234. -->>>
  235.